home *** CD-ROM | disk | FTP | other *** search
- /*
- * A Motif program to send and receive messages internally, to its own
- * buttons. This one has two local interpreters, and three registered names
- */
-
- #include <stdio.h>
- #include <Xm/Label.h>
- #include <Xm/PushB.h>
- #include <Xm/RowColumn.h>
- #include "../tclXtSend.h"
-
- void
- SendTo1(w, clientData, callData)
- Widget w;
- XtPointer clientData;
- XtPointer callData;
- {
- Tcl_Interp *interp = (Tcl_Interp *) clientData;
- char sendCommand[1024];
-
- strcpy(sendCommand,
- "send xmSend5.1 incrementLabel1");
- if (Tcl_Eval(interp, sendCommand) != TCL_OK)
- fprintf(stderr, "send failed: %s\n", interp->result);
- }
-
- void
- SendTo2(w, clientData, callData)
- Widget w;
- XtPointer clientData;
- XtPointer callData;
- {
- Tcl_Interp *interp = (Tcl_Interp *) clientData;
- char sendCommand[1024];
-
- strcpy(sendCommand,
- "send xmSend5.1 incrementLabel1");
- if (Tcl_Eval(interp, sendCommand) != TCL_OK)
- fprintf(stderr, "send failed: %s\n", interp->result);
-
- strcpy(sendCommand,
- "send xmSend5.2 incrementLabel2");
- if (Tcl_Eval(interp, sendCommand) != TCL_OK)
- fprintf(stderr, "send failed: %s\n", interp->result);
- }
-
- void
- SendTo3(w, clientData, callData)
- Widget w;
- XtPointer clientData;
- XtPointer callData;
- {
- Tcl_Interp *interp = (Tcl_Interp *) clientData;
- char sendCommand[1024];
-
- strcpy(sendCommand,
- "send xmSend5.1 incrementLabel1\n\
- send xmSend5.2 incrementLabel2\n\
- send xmSend5.3 incrementLabel3");
- if (Tcl_Eval(interp, sendCommand) != TCL_OK)
- fprintf(stderr, "send failed: %s\n", interp->result);
- }
-
-
- char incrementLabelCmd[] = "\
- proc incrementLabel1 {} { \n\
- getLabel1 value \n\
- incr value \n\
- setLabel1 $value \n\
- } \n\
- proc incrementLabel2 {} { \n\
- getLabel2 value \n\
- incr value \n\
- setLabel2 $value \n\
- } \n\
- proc incrementLabel3 {} { \n\
- getLabel3 value \n\
- incr value \n\
- setLabel3 $value \n\
- } \
- ";
-
- int
- SetLabel(clientData, interp, argc, argv)
- ClientData *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- XmString xmstr;
- Widget w = (Widget) clientData;
-
- if (argc < 2) {
- Tcl_SetResult(interp, "setLabel label", TCL_STATIC);
- return TCL_ERROR;
- }
-
- fprintf(stderr, "**Setting label to %s\n", argv[1]);
- xmstr = XmStringCreateLocalized(argv[1]);
- XtVaSetValues(w, XmNlabelString, xmstr, NULL);
- XmStringFree(xmstr);
-
- return TCL_OK;
- }
-
- int
- GetLabel(clientData, interp, argc, argv)
- ClientData *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- XmString xmstr;
- String str;
- Widget w = (Widget) clientData;
-
- if (argc < 2) {
- Tcl_SetResult(interp, "getLabel \"label\"", TCL_STATIC);
- return TCL_ERROR;
- }
-
- XtVaGetValues(w, XmNlabelString, &xmstr, NULL);
- XmStringGetLtoR(xmstr, XmFONTLIST_DEFAULT_TAG, &str);
- Tcl_SetVar(interp, argv[1], str, 0);
-
- XtFree(str);
- XmStringFree(xmstr);
-
- return TCL_OK;
- }
-
- int
- main(argc, argv)
- int argc;
- char **argv;
- {
- Widget toplevel;
- Widget rc;
- Widget button;
- Widget label;
- Tcl_Interp *interp1, *interp2, *interp3;
- XtAppContext app;
-
- toplevel = XtAppInitialize(&app, "XmSend", NULL, 0, &argc, argv,
- NULL, NULL, 0);
-
- interp1 = Tcl_CreateInterp();
- interp2 = Tcl_CreateInterp();
- interp3 = Tcl_CreateInterp();
-
- if (TclXtSend_RegisterInterp(interp1, "xmSend5.1", toplevel) == TCL_ERROR) {
- fprintf(stderr, "couldn't register interpreter 5.1\n");
- exit(1);
- }
-
- if (TclXtSend_RegisterInterp(interp2, "xmSend5.2", toplevel) == TCL_ERROR) {
- fprintf(stderr, "couldn't register interpreter 5.2\n");
- exit(1);
- }
-
- if (TclXtSend_RegisterInterp(interp3, "xmSend5.3", toplevel) == TCL_ERROR) {
- fprintf(stderr, "couldn't register interpreter 5.3\n");
- exit(1);
- }
-
- rc = XmCreateRowColumn(toplevel, "rc", NULL, 0);
- XtManageChild(rc);
- XtVaSetValues(rc,
- XmNpacking, XmPACK_COLUMN,
- XmNnumColumns, 2,
- NULL);
-
- button = XmCreatePushButton(rc, "Incr label1", NULL, 0);
- XtManageChild(button);
- XtAddCallback(button, XmNactivateCallback, SendTo1, (XtPointer) interp1);
-
- button = XmCreatePushButton(rc, "Incr 1&2", NULL, 0);
- XtManageChild(button);
- XtAddCallback(button, XmNactivateCallback, SendTo2, (XtPointer) interp2);
-
- button = XmCreatePushButton(rc, "Incr 1&2&3", NULL, 0);
- XtManageChild(button);
- XtAddCallback(button, XmNactivateCallback, SendTo3, (XtPointer) interp3);
-
- label = XmCreateLabel(rc, "1", NULL, 0);
- XtManageChild(label);
- Tcl_CreateCommand(interp1, "setLabel1", SetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp1, "getLabel1", GetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
-
- label = XmCreateLabel(rc, "2", NULL, 0);
- XtManageChild(label);
- Tcl_CreateCommand(interp2, "setLabel2", SetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp2, "getLabel2", GetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
-
- label = XmCreateLabel(rc, "3", NULL, 0);
- XtManageChild(label);
- Tcl_CreateCommand(interp3, "setLabel3", SetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp3, "getLabel3", GetLabel, (ClientData *) label,
- (Tcl_CmdDeleteProc *) NULL);
-
- XtRealizeWidget(toplevel);
-
- /*
- * Create tcl commands based in C, and then load a procedure
- */
- if (Tcl_Eval(interp1, incrementLabelCmd) != TCL_OK)
- fprintf(stderr, "couldn't load cmds: %s\n", interp1->result);
-
- if (Tcl_Eval(interp2, incrementLabelCmd) != TCL_OK)
- fprintf(stderr, "couldn't load cmds: %s\n", interp2->result);
-
- if (Tcl_Eval(interp3, incrementLabelCmd) != TCL_OK)
- fprintf(stderr, "couldn't load cmds: %s\n", interp3->result);
-
-
- XtAppMainLoop(app);
- }
-